MacFormat 1999 Spring/macformat-077.iso/Shareware Plus/Development/Akua Sweets 131/Akua Sweets Examples/Network/PowerSPrint 142/PowerSPrint Server

Text File | 1999-03-04 | 18.5 KB | 832 lines | [TEXT/ToyS]

(*
V1.42 ◊ This script is © 1998-1999 by AKUA interactive media AG.

See the included documentation for more information.

V142/26Feb99/Update to Akua Sweets V1.31 (creator 'AkuS'), fix removed orphan problem
V141/07Feb99/Fix "Touched of 0" error
V140/02Feb99/Fix some prefs stuff, fix size fork error in Akua Sweets
V130/22Jan99/Lots 'o Fixes - add return of printer configuration to prefs check
V120/10Jan99/Pass back Epson Settings to clients
V110/04Jan99/Redid a lot of stuff. Fixed a lot of bugs
V102/25Jul98/Work on timing to avoid Quadra Crash of AppleScript
V101/11Jul98/Better check of "initted" status, Quit when inactive, Better trashing of orphaned files.
*)

-- User setable properties
property kasAllowAlerts : true -- Set to false to stop any alerts from appearing
property kcnTimeOut : 300 -- Kill operations if not touched in this many seconds
property kasStayOpen : true -- Stay open all the time to avoid startup delays

-- Internal Properties
property kasFinder : "Finder" -- The Finder
property kpsTitle : "PowerSPrint Server"
property kpsVersion : "V1.42"
property kpsTitleW : kpsTitle & " " & kpsVersion
property kpfPrefName : kpsTitle & " V1.3" -- Prefs version

-- Internal Globals
property gasReady : false

global gdvPrefs -- (Epson) Driver Files & Dates

global gpsStatus -- Window with status info
global gpsStatLoc -- Location of status window
global gpsSpool -- Spool folder
global gpsSpooled -- Number of items in Spool folder
global gpsSpoolTypes -- Types of files stored in spool folder that our ours
global gpsWantLaunch -- Launch real print monitor?
global gpsPosted -- List of files to post process

global gpsMonitor -- Alias of our PrintMonitor
global gpsMonCre -- Creator of our PrintMonitor

global gcnFidBase -- Base file id
global gcnCopySlot -- List of copy slots
global gcnBatchSlot -- List of batch slots
global gcnWaitingFor -- # of Files we are awaiting

global gasInitted -- Just a holder to see if we've been initted
global gasLastTouch -- Last time touched


on run
    set gasReady to false
    init()
    spCheckLamers()
    return false
end run


on init()
    if ((the open windows) is {}) then -- No status window?
        set gasReady to false
        set gpsWantLaunch to false
        set gpsSpooled to 0
        set gcnWaitingFor to 0
        set gcnCopySlot to {}
        set gcnBatchSlot to {}
        set gpsPosted to {}
        set gcnFidBase to (pause for 0)
        set gasLastTouch to the clock in offset form
        set gdvPrefs to 0
        pfLoad()
        StatusNew()
    end if
end init


on idle
    init()

    if (not spSetup()) then
        Status("Waiting for Setup…")
        return 3
    end if

    Status("Thinking…")
    dvCheckPrefs()
    cnCheckOrphans()
    StatusUpdate()

    if (gcnWaitingFor is 0) then
        if (gpsSpooled > 0) then
            set gasLastTouch to the clock in offset form
            pmLaunch()
        else
            pmQuit()
        end if
        Status("Idle.")
    else
        if ((the clock in offset form) - gasLastTouch) > 120 then set gcnWaitingFor to 0 -- Lost clients?
        Status("Receiving " & gcnWaitingFor & " files.")
    end if

    if (gpsWantLaunch) then
        pmLaunch()
        set gpsWantLaunch to false
    end if

    if not kasStayOpen then ¬
        if ((the clock in offset form) - gasLastTouch) > 600 then quit

    set gasReady to true

    return 15
end idle


on CheckReady()
    return gasReady
end CheckReady


on quit
    set gasReady to false
    try
        StatusDel()
        pfSave()
    on error
        beep
    end try
    continue quit
end quit


on open fsObjs
    init()

    repeat with fsObj in fsObjs
        set fInfo to basic info for fsObj

        if (catalog kind of fInfo) is a folder then
            spSet(fsObj)
        else if (system type of fInfo) is "APPL" then
            pmSet(fsObj)
        else
            ShowErr("Not ready!")
        end if
    end repeat
end open


on pfLoad()
    try
        set prefs to load preference named kpfPrefName
    on error
        -- Default values
        set prefs to ¬
            {PfStatLoc:{44, 64} ¬
                , PfMonitor:0 ¬
                , PfMonCre:("") ¬
                , PfSpool:path to printmonitor ¬
                , PfSpoolTypes:{} ¬
                }
    end try

    -- Set globals from prefs
    set gpsStatLoc to PfStatLoc of prefs
    set gpsMonitor to PfMonitor of prefs
    set gpsMonCre to PfMonCre of prefs
    set gpsSpool to PfSpool of prefs
    set gpsSpoolTypes to PfSpoolTypes of prefs
end pfLoad


on pfSave()
    if (gpsStatus is not 0) then
        set newLoc to screen location of ¬
            (display info gpsStatus message "Saving prefs…" at line 2)
        if (not (the same data is in newLoc as in gpsStatLoc)) then ¬
            set gpsStatLoc to newLoc
    end if

    -- Appending {} to the end of this causes crashes in System 7.x
    set prefs to ¬
        {PfStatLoc:gpsStatLoc ¬
            , PfMonitor:gpsMonitor ¬
            , PfMonCre:gpsMonCre ¬
            , PfSpool:gpsSpool ¬
            , PfSpoolTypes:gpsSpoolTypes ¬
            }

    save preference prefs named kpfPrefName
end pfSave


on dvCheckPrefs()
    if (gdvPrefs is 0) then
        ShowAction("Scanning driver prefs…")
        set gdvPrefs to {}

        try
            set epf to (((path to preferences folder) as string) & "Epson Preferences") as alias
        on error
            ShowAction("…")
            return
        end try

        set pfs to the entries in epf whose types are in {"pref"}

        repeat with pf in pfs
            set pff to (epf as string) & pf
            set gcnt to the number of resources in pff ¬
                of type "Gest"
            if gcnt > 0 then ¬
                set gdvPrefs to gdvPrefs & {basic info for pff}
        end repeat
        ShowAction("…")
    end if
end dvCheckPrefs


on dvReturnFile(binfo)
    -- Return the contents of a driver pref file
    try
        set epf to (((path to preferences folder) as string) & "Epson Preferences") as alias
        set fsObj to (epf as string) & (catalog name of binfo)
    on error
        beep
        return
    end try

    try
        set df to read data from the data fork of fsObj
    on error
        set df to 0
    end try

    try
        set fk to open fork from fsObj ¬
            with resource fork
        set rf to read data from fk
        close fork fk
    on error
        set rf to 0
    end try

    return {df, rf}
end dvReturnFile


on pmLaunch()
    if (gpsMonCre is not "") then
        if (all processes given «class Creå»:gpsMonCre) is {} then
            Status("Launching Print Monitor")
            try
                arouse gpsMonitor
            on error
                ShowErr("Couldn't launch Monitor!")
            end try
        else
            Status("Print Monitor is up.")
        end if
    else
        Status("Error - No Print Monitor!")
    end if
end pmLaunch


on pmQuit()
    if (gpsMonCre is not "") and ¬
        (all processes given «class Creå»:gpsMonCre) is not {} then
        Status("Quitting Print Monitor")
        tell application (original name of (alias info from gpsMonitor)) to quit
    end if
end pmQuit


on pmSet(fsObj)
    set gpsMonitor to fsObj
    set gpsMonCre to system creator of (basic info for fsObj)
    pfSave()
    pmShow()
end pmSet


on pmShow()
    display info gpsStatus ¬
        message ("Monitor: " & (gpsMonitor as string)) ¬
        at line 10 ¬
        using color 16
end pmShow


on spSet(fsObj)
    set gpsSpool to fsObj
    pfSave()
    spShow()
end spSet


on spShow()
    display info gpsStatus ¬
        message ("Spool: " & (gpsSpool as string)) ¬
        at line 9 ¬
        using color 17
end spShow


on spNameFile(fname, tag)
    if (tag is not "") then
        if (character 2 of tag is "1") then
            set fname to tag & fname
        else
            set fname to replace data in fname ¬
                starting after position 0 ¬
                with contents of tag
        end if
    end if

    return fname
end spNameFile


on spCheckName(fname, tag)
    set fname to spNameFile(fname, tag)

    repeat while (the entries in gpsSpool whose names match fname) is not {}
        if (character 1 of fname is "◊") then
            set n to (the text 2 thru 5 of fname) as number
            set n to n + 1
            set tag to "◊" & (n as string)
            set fname to replace data in fname ¬
                starting after position 0 ¬
                with contents of tag
        else
            if (length of fname < 15) then
                set tag to "◊1000 "
                set fname to tag & fname
            else
                set tag to "◊2000 "
                set fname to replace data in fname ¬
                    starting after position 0 ¬
                    with contents of tag
            end if
        end if
    end repeat

    return tag
end spCheckName


on spCount()
    if (gpsMonCre is {}) then return 0
    return the number of items in ¬
        (the entries in gpsSpool whose creators are in {gpsMonCre})
end spCount


on spCheckLamers()
    set orphs to (the entries in gpsSpool whose creators are in {"AkuS"})
    set daddy to (gpsSpool as string)

    repeat with orph in orphs
        collate ((daddy & orph) as alias) with the deleter
    end repeat
end spCheckLamers


on spSetup()
    if (CheckReady()) then return true

    if (gpsStatus is not 0) then
        spShow()

        if (control key down of (input state)) then
            try
                open {choose file with prompt "Choose the Print Monitor" of type {"APPL"}}
            on error
                beep
            end try
        end if

        if (shift key down of (input state)) then
            try
                open {choose folder with prompt "Choose Spool Folder (e.g. Spool Folder5)"}
            on error
                beep
            end try
        end if

        if (gpsMonitor is 0) then
            display info gpsStatus ¬
                message ("Control Key = Choose Print Monitor") ¬
                at line 3 ¬
                using color (16 * 1024)
            display info gpsStatus ¬
                message ("Shift Key = Choose Spool Folder") ¬
                at line 4 ¬
                using color (15 * 1024)
            return false
        end if

        pmShow()

        display info gpsStatus ¬
            message ("Ready.") ¬
            at line 3 ¬
            using color (16 * 32)
        display info gpsStatus ¬
            message ("…") ¬
            at line 4 ¬
            using color (15 * 32)
    end if

    return true
end spSetup


on StatusNew()
    set gpsStatus to ¬
        display info titled kpsTitleW ¬
            message ("Starting up…") ¬
            located at gpsStatLoc
end StatusNew


on StatusUpdate()
    if (gpsStatus is not 0) then
        set gpsSpooled to spCount()

        set newLoc to screen location of ¬
            (display info gpsStatus ¬
                message ("Spooled Files: " & gpsSpooled))
        if (not (the same data is in newLoc as in gpsStatLoc)) then
            set gpsStatLoc to newLoc
            pfSave()
        end if
    end if
end StatusUpdate


on Status(msg)
    if (gpsStatus is not 0) then
        display info gpsStatus ¬
            message msg ¬
            at line 2
    end if
end Status


on ShowAction(msg)
    if (gpsStatus is not 0) then
        display info gpsStatus ¬
            message msg ¬
            at line 3
    end if
end ShowAction


on ShowErr(msg)
    if (gpsStatus is not 0) then
        set msg to "Err " & (the clock using form "%d-%h:%i:%s") & ": " & msg
        display info gpsStatus ¬
            message msg at line 8 ¬
            using bg color (30 * 1024) + (20 * 32) + 20
        if (last character of msg is "!") then beep
        pause for 300
    end if
end ShowErr


on StatusDel()
    set newLoc to screen location of ¬
        (display info gpsStatus with disposal)
    if (not (the same data is in newLoc as in gpsStatLoc)) then ¬
        set gpsStatLoc to newLoc
    set gpsStatus to 0
end StatusDel


on ClientReg()
    return {SrvrVersion:kpsVersion, SrvrApp:(resolve chain (path to me)), SrvrDrvrPrefs:gdvPrefs, SrvrSetup:printer configuration}
end ClientReg


on ClientInq()
end ClientInq


on cnBatchTouched(bn)
    set t to 0

    repeat with cs in gcnCopySlot
        if (not (the same data is in cs as in 0)) then
            if (the same data is in (rcBatchID of cs) as in bn) and ((rcTouched of cs) > t) then ¬
                set t to (rcTouched of cs)
        end if
    end repeat

    return t
end cnBatchTouched


on cnCheckOrphans()
    set n to the number of items of gcnCopySlot
    set nt to the clock in offset form

    repeat with i from 1 to n
        if (not (the same data is in (item i of gcnCopySlot) as in 0)) then
            copy rcBatchID of (item i of gcnCopySlot) to bn
            if (bn is 0) then
                set tt to rcTouched of (item i of gcnCopySlot)
            else
                set tt to cnBatchTouched(bn)
            end if
            if (nt - tt) > kcnTimeOut then ¬
                CopyEnd(i + gcnFidBase, 911)
        end if
    end repeat

    set n to the number of items of gpsPosted

    repeat with i from 1 to n
        copy item i of gpsPosted to po
        if (po is not 0) then
            -- Timed out?
            set bn to rcBatchID of po
            if (bn is 0) then
                set tt to (rcTouch of po)
            else
                set tt to cnBatchTouched(bn)
            end if
            if (nt - tt) > 900 then
                set orphan to (rcFile of po)
                try
                    set oinfo to (basic info for orphan)
                    -- Make sure it wasn't overwritten by a retry…
                    if (system type of oinfo is "Part") then ¬
                        collate orphan with the deleter
                    ShowErr("Removed completed orphan (" & nt & ", " & tt & ", " & bn & ")")
                on error
                    ShowErr("Can't remove orphan!")
                end try
                set item i of gpsPosted to 0
            end if
        end if
    end repeat
end cnCheckOrphans


on CopyPrep(cname, fNameList)
    init()

    set fileCnt to (number of items in fNameList)
    ShowAction(fileCnt & " file(s) from " & cname)
    set gcnWaitingFor to gcnWaitingFor + fileCnt

    set tag to ""
    repeat with fname in fNameList
        set tag to spCheckName(fname, tag)
    end repeat

    set cnt to (the number of items of gcnBatchSlot)
    set bid to cnt
    repeat with i from 1 to cnt
        if (item i of gcnBatchSlot) is 0 then
            set bid to i - 1
            exit repeat
        end if
    end repeat
    set bid to bid + 1

    set cs to {rcBatchID:bid, rcBatchFiles:fileCnt, rcBatchTag:tag}

    if bid ≤ cnt then
        set item bid of gcnBatchSlot to cs
    else
        set gcnBatchSlot to gcnBatchSlot & {cs}
    end if

    repeat with fname in fNameList
        set newName to spNameFile(fname, tag)
        -- write data to the data fork of ((gpsSpool as string) & newName) from buffer "Akua"
    end repeat

    set gasLastTouch to the clock in offset form
    return bid + gcnFidBase
end CopyPrep


on CopyBeg(cname, prepNumOrZero, fInfo)
    init()
    if (gpsSpool is 0) then return -1

    ShowAction("Copy from " & cname & ", batch: " & prepNumOrZero)

    set tag to ""
    if (prepNumOrZero is not 0) then ¬
        set tag to rcBatchTag of (item (prepNumOrZero - gcnFidBase) of gcnBatchSlot)
    set catalog name of fInfo to spNameFile(catalog name of fInfo, tag)

    set fid to (the number of items of gcnCopySlot)
    repeat with i from 1 to fid
        if (item i of gcnCopySlot) is 0 then
            set fid to i - 1
            exit repeat
        end if
    end repeat
    set fid to fid + 1

    ShowAction("Copy id " & fid)

    set dRef to 0
    set rRef to 0

    -- Make sure we create the file if it is 0 total long
    if ((data fork length of fInfo) > 0) or ((resource fork length of fInfo) is 0) then
        set dRef to open fork from gpsSpool ¬
            named (catalog name of fInfo) ¬
            of type ("Part") ¬
            of creator ("AkuS") ¬
            with write access
        size fork dRef to (data fork length of fInfo) with reservation
    end if

    if (resource fork length of fInfo) > 0 then
        set rRef to open fork from gpsSpool ¬
            named (catalog name of fInfo) ¬
            of type ("Part") ¬
            of creator ("AkuS") ¬
            with resource fork and write access
        size fork rRef to (resource fork length of fInfo) with reservation
    end if

    set dstAli to ((gpsSpool as string) & (catalog name of fInfo)) as alias
    set nowT to the clock in offset form

    set pg to display progress titled (cname & " (" & fid & ")") ¬
        subtitled (catalog name of fInfo) ¬
        maximum ((resource fork length of fInfo) + (data fork length of fInfo)) ¬
        located at {-1, -1} ¬
        labeled "Starting…"

    set cs to {rcClientName:cname ¬
        , rcBatchID:prepNumOrZero ¬
        , rcProgWind:pg ¬
        , rcBirthed:nowT ¬
        , rcTouched:nowT ¬
        , rcInfo:fInfo ¬
        , rcDestFile:dstAli ¬
        , rcDoingRsrc:false ¬
        , rcDataRef:dRef ¬
        , rcDataOff:0 ¬
        , rcRsrcRef:rRef ¬
        , rcRsrcOff:0}

    if fid ≤ (number of items of gcnCopySlot) then
        set item fid of gcnCopySlot to cs
    else
        set gcnCopySlot to gcnCopySlot & {cs}
    end if

    return fid + gcnFidBase
end CopyBeg


on CopyFork(fid, isRsrc)
    set fid to fid - gcnFidBase
    copy item fid of gcnCopySlot to cs

    if (the same data is in cs as in 0) then
        ShowErr("Error finding Fid in CF: " & fid & "!")
        return 912 -- timeout
    end if

    ShowAction("Copy Fork: " & catalog name of (rcInfo of cs))

    if (isRsrc) then
        set lbl to "Resource Fork"
    else
        set lbl to "Data Fork"
    end if

    set rcDoingRsrc of cs to isRsrc

    display progress (rcProgWind of cs) ¬
        labeled lbl

    set rcTouched of cs to the clock in offset form
    set item fid of gcnCopySlot to cs
    return 0
end CopyFork


on CopyChunk(fid, isRsrc, buf, dataOffset)
    set fid to fid - gcnFidBase
    set cs to item fid of gcnCopySlot

    if (the same data is in cs as in 0) then
        ShowErr("Error finding Fid in CC: " & fid & "!")
        return 913 -- timeout
    end if

    ShowAction("Copy Chunk: " & catalog name of (rcInfo of cs))

    set cnt to the data length of buf

    if (isRsrc) then
        set fRef to rcRsrcRef of cs
        copy rcRsrcOff of cs to fOff
        set rcRsrcOff of cs to (fOff + cnt)
    else
        set fRef to rcDataRef of cs
        copy rcDataOff of cs to fOff
        set rcDataOff of cs to (fOff + cnt)
    end if

    if (dataOffset is not fOff) then ¬
        return CopyEnd(fid, -50)

    write data to fRef ¬
        from buffer buf ¬
        at offset fOff

    display progress (rcProgWind of cs) ¬
        value ((rcRsrcOff of cs) + (rcDataOff of cs))

    set gasLastTouch to the clock in offset form
    set rcTouched of cs to gasLastTouch
    set item fid of gcnCopySlot to cs
    return 0
end CopyChunk


on CopyEnd(fid, errNum)
    set fid to fid - gcnFidBase

    set gcnWaitingFor to gcnWaitingFor - 1

    copy item fid of gcnCopySlot to cs
    set item fid of gcnCopySlot to 0

    if (cs is 0) then
        ShowErr("Error finding Fid in CE: " & fid & "!")
        return 914 -- timeout
    end if

    ShowAction("Copy Finish: " & catalog name of (rcInfo of cs))

    set pg to rcProgWind of cs
    if (pg is not 0) then display progress pg labeled "Finishing…"

    set dRef to rcDataRef of cs
    set rRef to rcRsrcRef of cs
    if (dRef is not 0) then close fork dRef
    if (rRef is not 0) then close fork rRef

    if (errNum is not 0) then
        ShowAction("Copy Finish: " & catalog name of (rcInfo of cs) & " ERR:" & errNum)
        collate (rcDestFile of cs) with the deleter
        if (pg is not 0) then display progress pg with disposal
        return errNum
    end if

    if (gpsSpoolTypes does not contain (system type of (rcInfo of cs))) then
        set gpsSpoolTypes to gpsSpoolTypes & (system type of (rcInfo of cs))
        pfSave()
    end if

    if (pg is not 0) then display progress pg with disposal

    set gpsWantLaunch to (gcnWaitingFor is 0)
    CopyPost(rcBatchID of cs, rcDestFile of cs, rcInfo of cs)

    ShowAction("Copied.")

    return 0
end CopyEnd


on CopyDone(batchNum)
    -- Called from client to show that a batch has completed
    -- … see CopyPrep to start a batch
    set foundSome to false

    set n to the number of items in gpsPosted

    repeat with i from 1 to n
        copy item i of gpsPosted to po
        if (po is not 0) then
            if the same data is in (rcBatchID of po) as in batchNum then
                try
                    set the catalog info of (rcFile of po) to (rcInfo of po)
                on error errStr number errNum
                    ShowErr("File System Error: " & errNum & "!")
                end try
                set item i of gpsPosted to 0
                set foundSome to true
            end if
        end if
    end repeat
    return foundSome
end CopyDone


on CopyPost(prepNum, fsObj, fsInfo)
    -- Post a "file info setting" for processing after the batch completes (CopyDone)
    -- … or do it now if prepNum (batchID) is 0
    if (prepNum is 0) then
        set the catalog info of fsObj to fsInfo
    else
        set newObj to {rcBatchID:prepNum ¬
            , rcFile:fsObj ¬
            , rcInfo:fsInfo ¬
            , rcTouch:the clock in offset form}

        set n to the number of items in gpsPosted
        repeat with i from 1 to n
            copy item i of gpsPosted to po
            if (po is 0) then
                set item i of gpsPosted to newObj
                return
            end if
        end repeat

        set gpsPosted to gpsPosted & {newObj}
    end if
end CopyPost